home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / Pascal / Applications / NIH Image 1.62b11 / Macros / LUT Macros < prev    next >
Text File  |  1996-05-22  |  11KB  |  506 lines
  1. macro 'Export LUT [E]';
  2. {Copies the current look-up table to a text window.}
  3. var
  4.   i:integer;
  5.   v:real;
  6.   tab:string;
  7. begin
  8.   RequiresVersion(1.54);
  9.   NewTextWindow('LUT',200,400);
  10.   tab:=chr(9);
  11.   for i:=0 to 255 do
  12.     Writeln(i:4,tab,RedLut[i]:4,tab,GreenLut[i]:4,tab,BlueLut[i]:4);
  13. end;
  14.  
  15. macro 'Import Text LUT';
  16. {
  17. Imports a LUT stored as three column (red, green, blue)
  18. text file. If there are four columns then the first column
  19. is assumed to conatin sequence numbers and is ignored.
  20. }
  21. var
  22.   i,r,g,b, width, height, start, row:integer;
  23. begin
  24.   RequiresVersion(1.53);
  25.   SetImport('Text');
  26.   Import('');
  27.   GetPicSize(width,height);
  28.   if width=3 then begin
  29.     r:=0;
  30.     g:=1;
  31.     b:=2
  32.   end else if width=4 then begin
  33.       r:=1;
  34.       g:=2;
  35.       b:=3
  36.   end else begin
  37.     PutMessage('The text file must have either 3 or 4 columns.');
  38.     exit;
  39.   end;
  40.   if height=255 then
  41.     start:=1
  42.   else if height=256 then
  43.       start:=0
  44.   else begin
  45.       PutMessage('The text file must have either 255 or 256 rows.');
  46.       exit;
  47.    end;
  48.   i:=start;
  49.   row:=0;
  50.   repeat
  51.     RedLut[i]:=GetPixel(r,row);
  52.     GreenLut[i]:=GetPixel(g,row);
  53.     BlueLut[i]:=GetPixel(b,row);
  54.     if (i mod 10) = 0 then UpdateLUT;
  55.     i:=i+1;
  56.     row:=row+1;
  57.   until row>=height;
  58.   UpdateLUT;
  59. end;
  60.  
  61. macro 'Invert LUT [I]';
  62. var
  63.   i:integer;
  64. begin
  65.   for i:=1 to 254 do begin
  66.     RedLUT[i]:=255-RedLut[i];
  67.     GreenLUT[i]:=255-GreenLut[i];
  68.     BlueLUT[i]:=255-BlueLut[i];
  69.   end;
  70.   UpdateLUT;
  71. end;
  72.  
  73.  
  74. macro 'Log Tranform';
  75. var
  76.   i,v:integer;
  77.   scale:real;
  78. begin
  79.   scale := 255.0 / ln(255.0);
  80.   for i:=1 to 254 DO begin
  81.     v := 255-round(ln(i) * scale);
  82.     RedLUT[i]:=v;
  83.     GreenLUT[i]:=v;
  84.     BlueLUT[i]:=v;
  85.   end;
  86.   UpdateLUT;
  87. end;
  88.  
  89.  
  90. macro 'Gamma Tranform… [G]';
  91. var
  92.   i,v:integer;
  93.   n,mode,min,max:integer
  94.   gamma,mean:real;
  95. begin
  96.   gamma:=GetNumber('Gamma(0.1-3.0):',2);
  97.   measure;
  98.   GetResults(n,mean,mode,min,max);
  99.   ShowMessage('min=',min:1,'\max=',max:1);
  100.   for i:=1 to 254 DO begin
  101.     if (i>min) and (i<max)
  102.       then v:=exp(gamma*ln((i-min)/(max-min)))*255 {x^y=exp(y*ln(x)}
  103.       else begin
  104.         if i<=min then v:=0 else v:=255;
  105.       end;
  106.     RedLUT[i]:=255-v;
  107.     GreenLUT[i]:=255-v;
  108.     BlueLUT[i]:=255-v;
  109.   end;
  110.   UpdateLUT;
  111. end;
  112.  
  113.  
  114. macro 'Square Transform';
  115. var
  116.   i,v:integer;
  117.   sqr255:real;
  118. BEGIN
  119.   sqr255:=sqr(255.0);
  120.   for i:=1 to 255 DO begin
  121.     v:=round(sqr(i)*255.0/sqr255);
  122.     RedLUT[255-i]:=v;
  123.     GreenLUT[255-i]:=v;
  124.     BlueLUT[255-i]:=v;
  125.   end;
  126.   UpdateLUT;
  127. END.
  128.  
  129. macro 'Parabolic Transform';
  130. { Generates a parabolic LUT}
  131. var
  132.   i,y:integer;
  133.   scale:real;
  134. begin
  135.   scale:=1;
  136.   for i:= 1 to 254 do begin
  137.     y:= (i-127)*(i-127)*scale/64.25;
  138.     if y > 255 then y:=255;
  139.     RedLUT[i]:=y;
  140.     GreenLUT[i]:= y;
  141.     BlueLUT[i]:=y;
  142.   end;
  143.   UpdateLUT;
  144. end;
  145.  
  146. macro 'Square Root Tranform';
  147. var
  148.   i,v:integer;
  149.   sqrt255:real;
  150. BEGIN
  151.   sqrt255:=sqrt(255.0);
  152.   for i:=1 to 255 DO begin
  153.     v:=round(sqrt(i)*255.0/sqrt255);
  154.     RedLUT[255-i]:=v;
  155.     GreenLUT[255-i]:=v;
  156.     BlueLUT[255-i]:=v;
  157.   end;
  158.   UpdateLUT;
  159. END;
  160.  
  161.  
  162. macro 'Reset LUT [R]';
  163. begin
  164.   ResetGrayMap;
  165. end;
  166.  
  167.  
  168. macro 'Plot LUT [P]';
  169. var
  170.   i,xscale,yscale:real;
  171.   width,height,margin,pwidth,pheight:integer;
  172.   xbase,ybase:integer;
  173. begin
  174.   SaveState;
  175.   margin:=25;
  176.   pwidth:=400;
  177.   pheight:=125;
  178.   width:=pwidth+2*margin;
  179.   height:=pheight*3+2*margin;
  180.   SetNewSize(width,height);
  181.   SetBackground(0); 
  182.   MakeNewWindow('LUT');
  183.   xscale:=(pwidth-2)/256;
  184.   yscale:=(pheight-1)/256;
  185.   SetForeground(252);
  186.   xbase:=margin; ybase:=margin;
  187.   MoveTo(xbase,ybase);
  188.   for i:=0 to 255 do
  189.     LineTo(xbase+i*xscale,ybase+RedLUT[i]*yscale);
  190.   SetForeground(255);
  191.   MakeRoi(xbase,ybase,pwidth,pheight);
  192.   FlipVertical;
  193.   DrawBoundary;
  194.   SetForeground(253);
  195.   ybase:=ybase+pheight-1;
  196.   MoveTo(xbase,ybase);
  197.   for i:=0 to 255 do
  198.     LineTo(xbase+i*xscale,ybase+GreenLUT[i]*yscale);
  199.   SetForeground(255);
  200.   MakeRoi(xbase,ybase,pwidth,pheight);
  201.   FlipVertical;
  202.   DrawBoundary;
  203.   SetForeground(254);
  204.   ybase:=ybase+pheight-1;
  205.   MoveTo(xbase,ybase);
  206.   for i:=0 to 255 do
  207.     LineTo(xbase+i*xscale,ybase+BlueLUT[i]*yscale);
  208.   SetForeground(255);
  209.   MakeRoi(xbase,ybase,pwidth,pheight);
  210.   FlipVertical;
  211.   DrawBoundary;
  212.   KillRoi;
  213.   RedLUT[252]:=255; GreenLUT[252]:=0;   BlueLUT[252]:=0;
  214.   RedLUT[253]:=0;   GreenLUT[253]:=255; BlueLUT[253]:=0;
  215.   RedLUT[254]:=0;   GreenLUT[254]:=0;   BlueLUT[254]:=255;
  216.   UpdateLUT;
  217.   SetFont('Geneva');
  218.   SetFontSize(9);
  219.   SetText('Centered');
  220.   MoveTo(margin+4,height-margin+8);
  221.   writeln(0:1:2);
  222.   MoveTo(margin+pwidth,height-margin+8);
  223.   writeln(255:1:2);
  224.   RestoreState;
  225. end;
  226.  
  227.  
  228. macro 'Posterize…';
  229. var
  230.   level,i:integer
  231.   delta,steps,StepSize,NextStep:real;
  232. begin
  233.   steps:=GetNumber('Number of Gray Steps(2-256):',8);
  234.   StepSize:=256/steps;
  235.   delta:=256/(steps-1);
  236.   NextStep:=trunc(StepSize);
  237.   level:=255;
  238.   for i:=0 to 255 do begin
  239.     if i>=NextStep then begin
  240.       NextStep:=trunc(NextStep+StepSize);
  241.       level:=level-delta;
  242.       UpdateLUT;
  243.     end;
  244.     if level<0 then level:=0;
  245.     RedLUT[i]:=level;
  246.     GreenLUT[i]:=level;
  247.     BlueLUT[i]:=level;
  248.   end;
  249.   UpdateLUT;
  250. end;
  251.  
  252.  
  253. macro 'Make Four Ramp LUT';
  254. var
  255.   i,entry:integer;
  256. BEGIN
  257.   entry:=0;
  258.   for i:=0 to 63 DO begin
  259.     RedLUT[entry]:=255-i*4;
  260.     GreenLUT[entry]:=255-i*4;
  261.     BlueLUT[entry]:=255-i*4;
  262.     entry:=entry+1;
  263.   end;
  264.   for i:=0 to 63 DO begin
  265.     RedLUT[entry]:=255-i*4;
  266.     GreenLUT[entry]:=0;
  267.     BlueLUT[entry]:=0;
  268.     entry:=entry+1;
  269.   end;
  270.    for i:=0 to 63 DO begin
  271.     RedLUT[entry]:=0;
  272.     GreenLUT[entry]:=255-i*4;
  273.     BlueLUT[entry]:=0;
  274.     entry:=entry+1;
  275.   end;
  276.   for i:=0 to 63 DO begin
  277.     RedLUT[entry]:=0;
  278.     GreenLUT[entry]:=0;
  279.     BlueLUT[entry]:=255-i*4;
  280.     entry:=entry+1;
  281.   end;
  282.   UpdateLUT;
  283. end.
  284.  
  285.  
  286. macro 'Set Pixels Red…';
  287. var
  288.  v1,v2,i:integer;
  289. begin
  290.     v1:=GetNumber('Starting Pixel Value(1-254)',10);
  291.     v2:=GetNumber('Ending Pixel Value(1-254)',10);
  292.     if v2<v1 then begin
  293.       PutMessage('Ending value less than starting value.');
  294.       exit;
  295.     end;
  296.     for i:=v1 to v2 do begin
  297.       RedLUT[i]:=255;
  298.       GreenLUT[i]:=0;
  299.       BlueLUT[i]:=0;
  300.     end;
  301.   end;
  302.   UpdateLUT;
  303. end;
  304.  
  305.  
  306. macro 'Nearly Gray LUT…';
  307. {
  308. Here is a macro that changes the LUT to make the values near 128 fairly visible when making polygon and line selections which use XOR drawing mode.
  309. Play around with it to get better results. It was written on the
  310. (incorrect) assumption that brightness = r+g+b.
  311. j is i xor 255 and also white is 255,255,255 not 0,0,0.
  312. {The brightness of each pixel is not quite right, there is a better way to get different colors with same brightness...)
  313. --Edward J. Huff (huff@mcclb0.med.nyu.edu)
  314. }
  315. var
  316.  i,j,d: integer;
  317. begin
  318.    while (d < 1) or (d > 63) do
  319.      d := GetNumber('Amount of color',20);
  320.   for i := d*2 to 127 do begin
  321.      j := 255 - i; 
  322.      RedLUT[i] := j + d;
  323.      GreenLUT[i] := j + d;
  324.      BlueLUT[i] := j - d*2;
  325.      RedLUT[j] := i - d*2;
  326.      GreenLUT[j] := i + d;
  327.      BlueLUT[j] := i + d;
  328.   end;
  329.   UpdateLUT;
  330. end;
  331.  
  332. macro 'Color Merge Two Images';
  333. {
  334. Merges a "red" image and a "green" image to create a
  335. composite color image. The macro does this by scaling both
  336. images to 0-15, multiplying the second by 16, creating a
  337. single 8-bit by ORing the two 4-bit images, and then
  338. generating a custom red and green LUT to display the
  339. composite image.
  340. }
  341. var
  342.   i,w1,w2,h1,h2,merged:integer;
  343. begin
  344.   SaveState;
  345.   if nPics<>2 then begin
  346.     PutMessage('This macro operates on exactly two images.');
  347.     exit;
  348.   end;
  349.   SelectPic(1);
  350.   GetPicSize(w1,h1);
  351.   SelectPic(2);
  352.   GetPicSize(w2,h2);
  353.   if (w1<>w2) or (h1<>h2) then begin
  354.     PutMessage('The two images must have the same width and height.');
  355.     exit;
  356.   end;
  357.   SetNewSize(w1,h2);
  358.   MakeNewWindow('Merged');
  359.   merged:=PicNumber;
  360.   SelectPic(1);
  361.   SelectAll;
  362.   Copy;
  363.   SelectPic(merged);
  364.   Paste;
  365.   SelectAll;
  366.   MultiplyByConstant(1/16);
  367.   ChangeValues(0,0,1);
  368.   ChangeValues(16,16,15);
  369.   SelectPic(2);
  370.   SelectAll;
  371.   Duplicate('Temp');
  372.   MultiplyByConstant(1/16);
  373.   ChangeValues(16,16,15);
  374.   MultiplyByConstant(16);
  375.   ChangeValues(0,0,1);
  376.   SelectAll;
  377.   Copy;
  378.   SelectPic(merged);
  379.   Paste;
  380.   DoOr;
  381.   for i:=0 to 255 do begin
  382.      RedLut[i]:=(i mod 16)*16;
  383.      GreenLut[i]:=(i div 16)*16;
  384.      BlueLut[i]:=0;
  385.    end;
  386.   UpdateLut;
  387.   SelectPic(nPics);
  388.   Dispose;  {Temp}
  389.   RestoreState;
  390. end;
  391.  
  392.  
  393. macro 'Move Slice Up [U]';
  394. var
  395.   lower,upper:integer;
  396. begin
  397.   GetThresholds(lower,upper);
  398.   lower:=lower-1;
  399.   upper:=upper-1;
  400.   if lower<1 then lower:=1;
  401.   if lower>254 then lower:=254;
  402.   if upper<lower then upper:=lower;
  403.   if upper>254 then upper:=254;
  404.   SetDensitySlice(lower,upper);
  405.   ShowMessage(lower:4,upper:4)
  406. end;
  407.  
  408. macro 'Move Slice Down [D]';
  409. var
  410.   lower,upper:integer;
  411. begin
  412.   GetThresholds(lower,upper);
  413.   lower:=lower+1;
  414.   upper:=upper+1;
  415.   if lower<1 then lower:=1;
  416.   if lower>254 then lower:=254;
  417.   if upper<lower then upper:=lower;
  418.   if upper>254 then upper:=254;
  419.   SetDensitySlice(lower,upper);
  420.   ShowMessage(lower:4,upper:4)
  421. end;
  422.  
  423. macro 'Change One LUT Entry…';
  424. var
  425.   dn:integer;
  426. begin
  427.   dn:=GetNumber('Gray Value(1-254):',128);
  428.   RedLut[dn]:=GetNumber('Red(0-255):',255);
  429.   GreenLut[dn]:=GetNumber('Green(0-255):',0);
  430.   BlueLut[dn]:=GetNumber('Blue(0-255):',0);
  431.   UpdateLUT;
  432. end;
  433.  
  434. macro 'Sort LUT by Hue';
  435. begin
  436.   SortPalette;
  437. end;
  438.  
  439.  
  440. macro 'Copy Calibration to LUT';
  441. var
  442.    i: integer;
  443.    value: integer;
  444.    scale, max, min: real;
  445. begin
  446.    max:=-999999;
  447.    min:=999999;
  448.    for i:= 0 to 255 do begin
  449.        value:=cvalue(i);
  450.        if value<min then min:=value;
  451.        if value>max then max:=value;
  452.    end;
  453.    scale := 255 / (max - min);
  454.    for i := 0 to 255 do begin
  455.                           value := 255 - round(scale * (cvalue(i) - min));
  456.                                 RedLUT[i] := value;
  457.                                 GreenLUT[i] := value;
  458.                                 BlueLUT[i] := value;
  459.                 end;
  460.                 UpdateLUT;
  461.     end;
  462.  
  463. MACRO 'Adjust Threshold'
  464.   VAR
  465.   level: INTEGER; 
  466. BEGIN
  467.    level:=50;
  468.    ShowMessage('Use shift-key to increase threshold \Use control-key to decrease threshold  \Use option-key when threshold is set'); 
  469.    REPEAT
  470.       IF KeyDown('shift') AND (level<255) THEN level:=level+1;
  471.       IF KeyDown('control') AND (level>0) THEN level:=level-1;
  472.       SetThreshold(level);
  473.    UNTIL KeyDown('option') or Button;
  474.   SetThreshold(-1);
  475. END;
  476.  
  477. macro 'Equalize';
  478. var
  479.   i, j, sum, v, w, h: integer;
  480.   scale: real;
  481. begin
  482.   GetPicSize(w, h);
  483.   GetHistogram(0, 0, w, h);
  484.   sum := 0;
  485.   for i := 0 to 255 do
  486.      sum := sum + histogram[i];
  487.   scale := 255 / sum;
  488.   sum := 0;
  489.   j := 255;
  490.   for i := 0 to 255 do begin
  491.      j := 255 - i;
  492.      sum := round(sum + histogram[j] * scale);
  493.      if sum > 255 then
  494.         sum := 255;
  495.      RedLut[j] := sum;
  496.      GreenLut[j] := sum;
  497.      BlueLut[j] := sum;
  498.   end;
  499.   UpdateLut;
  500. end;
  501.  
  502.  
  503.  
  504.  
  505.  
  506.